home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d10 / ps1410.arc / CAL1.BAS < prev    next >
BASIC Source File  |  1990-10-31  |  35KB  |  842 lines
  1.     '=========================================================================
  2.     ' Personal Calendar (PC) Program
  3.     '  Copyright (c) 1985-1990, Paul Munoz-Colman.  All Rights Reserved.
  4.     '    Version 14.10
  5.     '     31 Oct 1990
  6.     '    Shareware $25
  7.     '=========================================================================
  8.     '              DOS File CAL1.BAS
  9.     '              Main Program
  10.     '=========================================================================
  11.     '  Written For IBM PCs & Compatibles Under MS DOS 3.30 on a Northgate 486
  12.     '  Compiled By Microsoft Professional Development System (PDS) BASIC 7.10
  13.     '=========================================================================
  14.     '  Note -- Tabs in the source file are in positions 6,11,16,21,26,...
  15.     '=========================================================================
  16.     ' $INCLUDE: 'cal1.bi'
  17.     ProgramVersion$ = "14.10"            ' Version Number (ß just in case)
  18.     '=========================================================================
  19.     '   Compiled as (modules CAL1 and CALU)
  20.     '
  21.     '     "bc cal1 /e /o ; /cmd"
  22.     '
  23.     '   Other Compiler Options For Other Modules
  24.     '
  25.     '     Modules CAL2 through CAL6
  26.  
  27.     '      "bc cal2 /o; /cmd"
  28.     '
  29.     '   Linked By Microsoft Segmented-Executable LINK Version 5.10
  30.     '
  31.     '     "link stay4+cal1+cal2+cal3+cal4+cal5+cal6+calu+nocom+noevent+
  32.     '        tscnionr,cal,cal,srp4+mhlib2+mhpro+mhpro7/e/noe ;"
  33.     '
  34.     '   Linker Main Program -- stay4.obj  from MicroHelp, Inc (Stay-Res 4)
  35.     '   Linker Libraries    -- srp4.lib   from MicroHelp, Inc (Stay-Res 4)
  36.     '                          mhlib2.lib from MicroHelp, Inc (Mach2)
  37.     '                          mhpro.lib  from MicroHelp, Inc (QB/Pro 1-4)
  38.     '                          mhpro7.lib from MicroHelp, Inc (QB/Pro 7)
  39.     '=========================================================================
  40.     ' Appreciation to Herb Goertzel for his graphics ideas and some of his
  41.     '  simple but brilliant mathematics.
  42.     '=========================================================================
  43.     '                        PROGRAM CAPABILITIES
  44.     '-------------------------------------------------------------------------
  45.     '    Appointment File
  46.     '         20 to 300 Events -- Default 60
  47.     '         20 to 300 Notes -- Default 60
  48.     '         Unlimited History
  49.     '         Privacy
  50.     '         Print or Copy to ASCII File -- Includes Current Calendars
  51.     '    Event Management
  52.     '         One-Time
  53.     '         Repeating
  54.     '              Daily, Bi/MultiWeekly, Biweekly, Monthly, Quarterly, Yearly
  55.     '              Limited Number of Repeats
  56.     '              Automatic Rescheduling
  57.     '         Warnings and Alarms (Variable Music)
  58.     '    Clock Screen
  59.     '         Analog and Digital Time Display
  60.     '         Event and Note Display Window
  61.     '         Three-Month Calendar Display -- changable / scrollable
  62.     '    User Interface
  63.     '         Menu Driven
  64.     '         Instructions on Screen
  65.     '         Simple Commands
  66.     '         Friendly
  67.     '         Help for New Users is Automatic
  68.     '         DOS Shell And Return
  69.     '    Environment
  70.     '         DOS 2.01a, 2.10, 3.00, 3.10, 3.20, 3.21, 3.30, 4.01
  71.     '         IBM-PC, XT, AT, Clones
  72.     '         Easy to Move and Reinstall
  73.     '            Shareware $25 (12.75 and prior were free)
  74.     '    Options
  75.     '         Automatic Startup
  76.     '         7 Pairs of Color Choices on Color CRT (preset on Mono CRTs)
  77.     '         Change DOS Date and Time
  78.     '         Variable Clock Screen Footer for Notes and Events
  79.     '         Variable Music Selection For Alarms, Warnings, and Chimes
  80.     '         Variable Event Warning Time
  81.     '         Variable Sound Choices
  82.     '         Change Privacy Password
  83.     '         Change Contents of Print or ASCII File
  84.     '         Exclude Events from History
  85.     '         Disallow Event Rescheduling on Weekends
  86.     '         Printer Choice of IBM Color Graphics, Epson FX, IBM 4019 Laser,
  87.     '          HP IIP/III/IIID Laser or User-Initialized
  88.     '         Vary Capacity of Events and Notes
  89.     '         Pop-Up/Pop-Down (Terminate and Stay Resident (TSR))
  90.     '-------------------------------------------------------------------------
  91.     '         MAIN PROGRAM STRUCTURE (File CAL1.BAS)
  92.     '    (requires /E because of global error handler and RESUME {linelabel})
  93.     '-------------------------------------------------------------------------
  94.     '                            Start MainSub (1)
  95.     '    GlobalHandler                 Error Processor for All Modules
  96.     '                                  Returns All Errors to MainSub (2) or (3)
  97.     '    BuildMenuDate(EventDate$)    For BuildMenuLine - Day/Date Function
  98.     '    FileListGet                For FileList - FILES Function
  99.     '    GetApptRecord (Pointer)       Get Appt File Record / Fix Null Record
  100.     '    PlayStuff (PlayString$)       Play Music
  101.     '    ReadCalautoGet                Get for ReadCalauto
  102.     '    ReadCalDOSGet                Get for ReadCalDOS
  103.     '    ReadCalexclGet                Get for ReadCalexcl
  104.     '    ReadCalfigGet                Get for ReadCalfig
  105.     '    ReadCalinit (EntryPoint)        Get initialization parameters
  106.     '    ReadCalmusicGet            Get for ReadCalmusic
  107.     '    ReadCalresGet                Get for ReadCalres
  108.     '    ReadCalser                Get validation data
  109.     '    SetDateTimeGet (WhichType, DateTimeChange$)   Change Date/Time
  110.     '-------------------------------------------------------------------------
  111.     '    MAIN SUBPROGRAM INDEPENDENTLY COMPILED (File CAL2.BAS) 
  112.     '     (don't require /E or /X because global error handler in CAL1.BAS)
  113.     '-------------------------------------------------------------------------
  114.     '    MainSub (MainEntryPoint)
  115.     '            Definitions                    Entry Point 1
  116.     '            One-Time Data Initialization
  117.     '            Greeting Screen                Entry Point 2
  118.     '            Main Menu Entry                Entry Point 3
  119.     '            Open Event File
  120.     '            Display Event Editing Menu
  121.     '            Initialize Time Block
  122.     '            Display Time Block
  123.     '            Update Time And Date
  124.     '            Check Table To Sound The Alarm
  125.     '            Alarm Found
  126.     '            Update Clock Display
  127.     '            Sound The Alarm If Loaded
  128.     '            Keystroke For Alternative Actions
  129.     '-------------------------------------------------------------------------
  130.     '         SUBPROGRAMS INDEPENDENTLY COMPILED (File CAL3.BAS)
  131.     '     (don't require /E or /X because global error handler in CAL1.BAS)
  132.     '-------------------------------------------------------------------------
  133.     '    ApptToMenu (EntryPoint)        Get Event Record to Menu Line Format
  134.     ' Fn ASCIIN$ (ASCIIZString$)       Strip Chr$(0) From ASCIIZ String
  135.     ' Fn ASCIIZ$ (ASCIIString$)        Add Chr$(0) to ASCII String
  136.     '    AutoStart                     Automatic Startup Setting Menu
  137.     '    BigChars (CharsLin%, CharsColumn%, ChLin$)  Interface with MhChars
  138.     '    BlankError                    Clear Error Message
  139.     '    BlankFatal                    Clear Fatal Error (2 lines)
  140.     ' Fn BlankFill$ (ToBlankFill$)     Leading Zeroes to Blanks in String
  141.     '    BoxDraw (Type, Top, Bottom, Left, Right)   Draw Box with MhBox
  142.     '    BuildMenuLine                 Construct Menu Event Line    
  143.     '    CheckDate (DatetoValidate$)   See If Date Is Really a Date
  144.     '    ClearLast3                    Blank Last 3 Screen Lines
  145.     '    ClearLast4                    Blank Last 4    "
  146.     '    ClearOverdueTable             Clear Events Overdue Listing 
  147.     '    ClearScreenNormal (TimerDesired)
  148.     '                                  Clear Screen with Cl1f,Cl1b colors
  149.     '    CloseFiles                    Close All Data Files
  150.     '    ColorDecode (ColorAttribute)  Get Colors from Attribute
  151.     '    CombineDateTime               Merge Date/Time Fields
  152.     '    CompressApptFile (ShrinkNumber)
  153.     '                                  Compress Appt File ShrinkNumber Recs
  154.     '    ComputePendingValue (AlarmValue#,PendingValue#)
  155.     '                                  Calculate Warning Date/Time
  156.     '    ControlledInput (BoxRow,BoxColumn,MessageRow,MessageColumn,Length,_
  157.     '         MessageText$,InputResponse$,NumlockRequest,FilenameShow,_
  158.     '         ScreenBottomsShow,HoldAtEnd)  General Input Routine
  159.     '    Credits (WhichLine)            Address, Phone #, Price or Owner
  160.     '    DayDate (DatetoIndex$)        Get Day of Week and count for a Date
  161.     ' Fn    DirectoryExist(DirectoryName$) Interface with MhDirExist
  162.     '    DirectReturnCheck             Whether Returning To Clock Screen
  163.     '    DisplayApptFilename           Show Appointment File Name on Menus
  164.     '    DOSBIOSServices            Interface to MhDOS2
  165.     '    DoShell (ShellCommand$)       Run a Shell Command
  166.     '    DOSShell                      Run DOS Session and Return
  167.     '    EndItAll                      Return to DOS
  168.     '    ErrorHandler                  Error Condition Message Generator
  169.     '    EscapeLine                    Esc to Return Instruction
  170.     '    EscapeLineDelete              Esc to Return Instruction Blankout
  171.     '    EventErrorMessage             Display Error On Editing Instructions
  172.     ' Fn FileExist(ExistFilename$)    Interface with MhFileExist
  173.     '    FileFormat                    Change Number of Notes/Events in File
  174.     '    FileList                      Display List of Appointment Files
  175.     '    GenerateGreeting              Display Main Menu Greeting
  176.     '    GenGreetingScreen1            Startup Screen
  177.     '    GetFilenameLength             Get Length of Appointment File Name
  178.     '    GetOptions                    Read Options from Appointment File
  179.     '    Help                          Help Function
  180.     '    IncrementDate (DatetoIncrement$)
  181.     '                                  Change a Date to the Next Date
  182.     '    InitPrinter                   Initialize Printer w/Control Codes
  183.     '-------------------------------------------------------------------------
  184.     '         SUBPROGRAMS INDEPENDENTLY COMPILED (File CAL4.BAS)
  185.     '     (don't require /E or /X because global error handler in CAL1.BAS)
  186.     '-------------------------------------------------------------------------
  187.     ' Fn    InString                    Interface with MhInstr
  188.     '    Instructions                  Bottom of Clock Screen Instructions
  189.     '    KeyStuff (KeyFunction)        Get a Keystroke, Display Key States
  190.     '    KillAFile (KillFilename$)    Interface with MhKill
  191.     '    Kolors (WhichSetting)         Change Color Setting
  192.     ' Fn Leap (LeapInput)              Check if Given Year is a Leap Year
  193.     '    LprintString (PrintString$,HoldPrint)
  194.     '                                  Send to Printer With Error Recovery
  195.     '    MajorBeeper                   Severe Attention Music (Errors)
  196.     '    MenuDriver (MenuSize, MenuChoice, MenuRow, MenuColumn,
  197.     '         MenuSingleLine, MenuSpecialExit, ScreenBottomsShow, FilenameShow)
  198.     '                                  Menu Processor
  199.     '    MinorBeeper                   Mild Attention Music (Messages)
  200.     '    MoveApptRecords
  201.     '         (FileStart, MoveStart, MoveEnd, MoveIncr, MoveOrigin,
  202.     '          MoveTarget, MoveFlag, BlankFlag, BlankAt)
  203.     '                                  Shift Records In Appointment File
  204.     '    Myd2 (Destin$, DestinStart%, Chars%, Source$)
  205.     '                            Interface with MhMidString (Statement)
  206.     '    NotesHistory (NotesorHistory$)
  207.     '                                  Change Notes and History Menu
  208.     ' Fn    NumberError (NumberTest$)     Check for Non-Numeric Characters
  209.     '    OpenAppts                     Open Appointment File and Set FIELD
  210.     '    Options                       Options Menus
  211.     '    PageEject                     Eject Printer Page
  212.     '    PlayAlarmWarning (WarningSet)
  213.     '                                  Play Alarm or Warning Music String
  214.     '    PopLine                       F10 to Pop Down Prompt
  215.     '    PopLineDelete                 Erase Pop Down Prompt
  216.     '-------------------------------------------------------------------------
  217.     '         SUBPROGRAMS INDEPENDENTLY COMPILED (File CAL5.BAS)
  218.     '     (don't require /E or /X because global error handler in CAL1.BAS)
  219.     '-------------------------------------------------------------------------
  220.     '    PoppedOverCheck               Check to See Whether Popped Over DOS
  221.     '    PrepareforError               Clear and Place for Error Message
  222.     '    PrepareforFatal               Prepare for QuickBASIC Error Message
  223.     '    PrepareforMessage             Clear and Place for Info Message
  224.     '    PrintCalendar                 Display Three Months of Calendars
  225.     '    PrintCopy                     Print or Copy Appointments to ASCII File
  226.     '    ProcessAlarm                  Update Event and History Upon Alarm
  227.     '    PutApptRecord (Pointer)       Put Records in Appt File (Blank if 0)
  228.     '    QuickSort (Low, High)        Sort Alarm Table Routine
  229.     '    QuitLine                      Ctl-ESC to Quit Instruction
  230.     '    QuitLineDelete                Ctl-ESC to Quit Instruction
  231.     ' Fn RandInt% (Lower, Upper)        Random integer from lower to upper
  232.     '    ReadCalauto                   Read Auto Start CALAUTO.DAT File
  233.     '    ReadCalDOS                    Read DOS Command CALDOS.DAT File
  234.     '    ReadCalexcl                   Read Exclusion CALEXCL.DAT File
  235.     '    ReadCalfig                    Read Colors CALFIG.DAT File
  236.     '    ReadCalmusic                  Read CALMUSIC.DAT File
  237.     '    ReadCalres                    Read CALRES.DAT File
  238.     '    RefreshEventsNotes            Display Clock Screen Footer
  239.     '    RepackApptRecord              Build Event Record From Fields
  240.     '    RestoreCalKeyState            Restore State of Ins,Caps,Num,Scrl
  241.     '    RestoreDOSKeyState            Restore State of DOS Ins,Caps,Num,Scrl
  242.     '    ReturnLine                    Enter Instruction
  243.     '    ReturnLineDelete              Enter Instruction Blank Out
  244.     '    SaveCurrentDirectory (EntryPoint)
  245.     '                                  Get Program or User Directory
  246.     '    SaveDOSKeyState               Save State of DOS Ins,Caps,Num,Scrl
  247.     '    ScreenBottoms                 Esc, Quit, and Return Instructions
  248.     '    ScreenBottomsDelete           Esc, Quit, and Return Instructions Blank
  249.     '    SequenceEventsTable             Sort Events Listing
  250.     '    SetArrays                     Set Array Sizes Based Upon Event File
  251.     '    SetColors                     Color Choice Menus
  252.     '    SetCurrentDirectory (EntryPoint)
  253.     '                                  Change to Current or User Directory
  254.     '-------------------------------------------------------------------------
  255.     '         SUBPROGRAMS INDEPENDENTLY COMPILED (File CAL6.BAS)
  256.     '     (don't require /E or /X because global error handler in CAL1.BAS)
  257.     '-------------------------------------------------------------------------
  258.     '    SetDateTime                   Change DOS Date and Time
  259.     '    SetOptions                    Write Options to Appointment File
  260.     '    SetVideoMode (Why)            Set User or Calendar Video Mode
  261.     '    SetVideoPage (Why)            Set Page Zero or User Page
  262.     '    ShowErase (Kolor,ScreenRow,ScreenColumn,EraseFirst,ShowString$)
  263.     '                                  Locate, Erase, and Display
  264.     '    ShowIt (Kolor,ScreenRow,ScreenColumn,ShowString$)
  265.     '                                  All Screen Displays
  266.     '    ShowMult (Kolor,ScreenMultRow,ScreenColumn,EraseFirst,
  267.     '         ScreenMultLines)         ShowErase for Multiple Lines
  268.     '    ShowOverduePage               Display Excess Overdue Events
  269.     '    Snooze (Secs!)                Sleep for Seconds
  270.     '    StayResInitialization        Stay Res Plus Startup Code
  271.     '    StayResKeyName                Get English Hot Key Name
  272.     '    StayResKeyShiftList           For a Shift Code, Get Scan List Pointer
  273.     '    StayResOptions (SrAutoOptions)  Stay-Res Plus Options Menu/Check
  274.     '    StayResPopDown (EntryPoint)   Pop Down
  275.     ' Fn    Strng$ (RptTimes%, FillChar%) Replacement for STRING$ (MhString)
  276.     '    Titles (NumberofLines)        Generate Screen Titles (1 to 4 Lines)
  277.     '    UnpackApptRecord              Unpack Event Record to Fields
  278.     '    UpdateClockScreen             Change Date & Time On Clock Screen
  279.     '    ValidateEventDate             Check if Date Is Good
  280.     '    VideoMonitorType              Check Color or Monochrome Monitor
  281.     '    WindowInit                    Initialize MhWind
  282.     '    WindowRestore                 Restore User or Program Screen
  283.     '    WindowSave                    Save User or Program Screen
  284.     '    WriteCalauto                  Write Auto Startup CALAUTO.DAT File
  285.     '    WriteCalDOS                   Write DOS Command CALDOS.DAT File
  286.     '    WriteCalexcl                  Write Exclusion CALEXCL.DAT File
  287.     '    WriteCalfig                   Write Color Choice CALFIG.DAT File
  288.     '    WriteCalmusic                 Write CALMUSIC.DAT File
  289.     '    WriteCalres                   Write CALRES.DAT File
  290.     '    WritetoHistory                Write Event to History (Check Exclusion)
  291.     '    YearAdjust (YeartoAdjust,AdjustedYear$)
  292.     '                                  Change Numeric Year To String Length 4
  293.     ' Fn ZeroFill$ (ToZeroFill$)       All Blanks to Zeroes in String
  294.     '-------------------------------------------------------------------------
  295.     '         SUBPROGRAMS INDEPENDENTLY COMPILED (File CALU.BAS or CALSR.BAS)
  296.     '     (don't require /E or /X because global error handler in CAL1.BAS)
  297.     '-------------------------------------------------------------------------
  298.     '    ValidateUser (WhichLine)        Registration
  299.     '-------------------------------------------------------------------------
  300.     '         SUBPROGRAMS LINKED FROM MICROHELP QB/PRO 1-4 PACKAGE (MHPRO)
  301.     '-------------------------------------------------------------------------
  302.     '    MhBackwardInstr            Ctrl-Right-Left Implementation
  303.     '    MhDirExist                See If a Directory Exists
  304.     '    MhFileExist                See If a File Exists
  305.     '    MhHexToInt                Converts Hex String to Integer
  306.     '    MhInstr                    Replaces INSTR
  307.     '    MhIntToString                STR$ Replacement for Integers
  308.     '    MhKill                    Delete A File without Errors
  309.     '    MhLprint                    Line Printer Support
  310.     '    MhLset                    Replacement for LSET Statement
  311.     '    MhMidString                Replacement for MID$ Statement (Myd2)
  312.     '    MhNotBackwardInstr            Ctrl-Right-Left Implementation
  313.     '    MhNotInstr                 Ctrl-Right-Left Implementation
  314.     '    MhRename                    Rename a File (replaces NAME)
  315.     '    MhString                    Replacement for STRING$ (see Strng$)
  316.     '    MhToggleBits                Registration
  317.     '-------------------------------------------------------------------------
  318.     '         SUBPROGRAMS LINKED FROM MICROHELP QB/PRO 7 PACKAGE (MHPRO7)
  319.     '-------------------------------------------------------------------------
  320.     '    Mh80x25                    Change screen size to 25 lines
  321.     '    Mh80x43                    Change screen size to 43 lines
  322.     '    Mh80x50                    Change Screen size to 50 lines
  323.     '-------------------------------------------------------------------------
  324.     '         SUBPROGRAMS LINKED FROM MICROHELP MACH2 PACKAGE (MHLIB2)
  325.     '-------------------------------------------------------------------------
  326.     '    MhBox                         Box Display
  327.     '    MhChars                       Large Character Display
  328.     '    MhColorAttribute              Compute Color Attribute
  329.     '    MhDir                         Directory Services
  330.     '    MhDisk                        Check Disk Free Space
  331.     '    MhDisplay                     Display Mode Test
  332.     '    MhDos2                        Get Cursor Information
  333.     '    MhDver                        Get DOS Version Number
  334.     '    MhGetKbStatus1                Caps/Num Status Check
  335.     '    MhGetKbStatus2                Insert Pressed Check
  336.     '    MhInstat                      Keystroke Buffer Check for Traps & Exit
  337.     '    MhSetKBStatus                 Keyboard State Change
  338.     '    MhScr                         Screen Display
  339.     '    MhWind                        Window Manager for Screen Save/Restore
  340.     '-------------------------------------------------------------------------
  341.     '    SUBPROGRAMS LINKED FROM MICROHELP STAYRES PLUS (STAY4.OBJ & STAY4.LIB)
  342.     '-------------------------------------------------------------------------
  343.     '    SrAutoScreenSave (FileName$, Ecode%)
  344.     '    SrCancelAutoScreenSave ()
  345.     '    SrCancelShell ()
  346.     '    SrCheckEMS (Ecode%)
  347.     '    SrForceFile0 ()
  348.     '    SrNoSnow ()
  349.     ' Fn    SrOverDos% ()
  350.     '    SrPopDown (Kscan%, Kshift%, Ecode%)
  351.     '    SrReleaseMem (Ecode%)
  352.     '    SrReleaseTimeY ()
  353.     '    SrResetHotkey (Kscan%, Kshift%)
  354.     '    SrResidentBatch (CmndLine$, Ecode%)
  355.     '    SrResidentShell (CmndLine$, Ecode%)
  356.     '    SrSetBusyWait (Ticks%)
  357.     '    SrSetCom (Port%, Ecode%)
  358.     '    SrSetDiskSwap (FileName$, Ecode%)
  359.     '    SrSetId (IDName$, IDNumber%, Ecode%)
  360.     '    SrSetPokeChar (Ascii%)
  361.     '    SrSetTimeY (Month%, Day%, Year%, Hour%, Minute%)
  362.     '    SrSetUserMem (Bytes&)
  363.     '    SrSetVideoMode (Mode%)
  364.     '    SrUseErrorTable ()
  365.     '=========================================================================
  366.     ON ERROR GOTO GlobalHandler
  367.         Subnum = 0
  368.     CurrentStackSize& = 4000&            'Larger Stack for Recursion
  369.     STACK CurrentStackSize&                '  May increase it later
  370.     CALL MainSub (1)                    ' Main Program Starts
  371.     '=========================================================================
  372.     '#########################################################################
  373.     '#########################################################################
  374.     '=========================================================================
  375.     '  Control NEVER Returns Here, Except to Use the Global Error Handler
  376.     '=========================================================================
  377.     '   GLOBAL ERROR HANDLER FOR ALL MODULES
  378.     '=========================================================================
  379.     '  This is the ONLY module-level error handler in CAL.  It takes advantage
  380.     '   of the BASIC feature to trace back through the CALL stack to an active
  381.     '   handler.  Control is returned to MainSub in CAL2, which is truly a
  382.     '   recursive procedure (i.e. CALL'd when already active)
  383.     '=========================================================================
  384. GlobalHandler:                        ' Enter the Global Handler
  385.     CALL ErrorHandler                ' Construct the error messages
  386.     '---------------------            ' Reset all critical variables
  387.     RESUME ErrorStatusOff            ' Resume to go back to MainSub
  388. ErrorStatusOff:                    '  resetting stack if it's too low
  389.     ON ERROR GOTO GlobalHandler
  390.     '=========================================================================
  391.     '  Check the Stack to make sure it's not too low.  Increase it if it falls
  392.     '  below 3000 bytes by 1500 at a time.
  393.     '---------------------
  394.     NewStackSize& = CurrentStackSize& + 1500&    ' Proposed New Size
  395.     IF STACK => NewStackSize& THEN             ' If Stack Can Grow And
  396.         IF FRE(-2) <= 3000& THEN                '  and if stack space is low
  397.             CurrentStackSize& = NewStackSize&
  398.             STACK CurrentStackSize&            '  then increase it
  399.         END IF
  400.     END IF
  401.     '=========================================================================
  402.     '  Return to main menu            ' Make no mistake ... if we've come
  403.     IF PrimitiveState THEN            ' here, we're preparing for a 
  404.         LOCATE 19, N1                ' recursive call to MainSub, which adds
  405.         PRINT ErrorLine1$            ' about 50-60 bytes to the stack
  406.         PRINT ErrorLine2$
  407.         PRINT "Program initialization is incomplete.  Cannot proceed."
  408.         SYSTEM
  409.       ELSEIF StartupScreenHold THEN
  410.         CALL MainSub(N2)            ' Resumes at StartupScreenExit
  411.       ELSE
  412.         CALL MainSub(N3)            ' Resumes at MainMenuEntry
  413.     END IF
  414.     '=========================================================================
  415.     '#########################################################################
  416.     '#########################################################################
  417.     '=========================================================================
  418.     '  Control NEVER Gets Here--Program Terminates in EndItAll
  419.     '=========================================================================
  420.     '=========================================================================
  421.     '  SUBs That Require Error Handling Do The Minimum Necessary Here
  422.     '=========================================================================
  423.     SUB BuildMenuDate(BuildEventDate$)  STATIC
  424.     '=========================================================================
  425.     DEFINT A-Z
  426.     '  For BuildMenuLine
  427.         SubnumSave = Subnum
  428.         Subnum = 124
  429.     ON LOCAL ERROR GOTO DateError
  430.             CALL DayDate(BuildEventDate$)
  431. DateResume:
  432.             ON LOCAL ERROR GOTO 0
  433.     EXIT SUB
  434.         Subnum = SubnumSave
  435. DateError:
  436.     ErrorSwitch = Yes
  437.     RESUME DateResume
  438.     END SUB
  439.     '=========================================================================
  440.     SUB FileListGet  STATIC
  441.     '=========================================================================
  442.     DEFINT A-Z
  443.     '  Error Handling for FileList (FILES Function)
  444.         SubnumSave = Subnum
  445.         Subnum = 125
  446.     ON LOCAL ERROR GOTO FilesError
  447.     FILES "*.cld"
  448. FilesResume:
  449.     ON LOCAL ERROR GOTO 0
  450.         Subnum = SubnumSave
  451.     EXIT SUB
  452. FilesError:
  453.     IF ERR = 53 THEN
  454.         ErrorSwitch = Yes
  455.         RESUME FilesResume
  456.       ELSE
  457.         ERROR ERR
  458.     END IF
  459.     END SUB
  460.     '=========================================================================
  461.     SUB GetApptRecord (Pointer) STATIC
  462.     '=========================================================================
  463.     '  Get a Record From the Appointment File
  464.     '   If a Null String Then Replace it by Blanks
  465.     DEFINT A-Z
  466.         SubnumSave = Subnum
  467.         Subnum = 107
  468.     ON LOCAL ERROR GOTO GetError
  469.     GET FilenumAppt, Pointer
  470. GetResume:
  471.     ON LOCAL ERROR GOTO 0
  472.     IF ErrorSwitch THEN
  473.         ErrorSwitch = No
  474.         CALL OpenAppts
  475.         GET FilenumAppt, Pointer
  476.     END IF
  477.     IF ApptBuffer$ = ZeroLine THEN    ' Replace Null Record
  478.         CALL MhLset (ApptBuffer$, Blank80$)
  479.         CALL PutApptRecord(Pointer)
  480.     END IF
  481.     IF Pointer > N1 AND Pointer <= NumberOfEvents + N1 THEN
  482.         CurrentEventRecord$ = ApptBuffer$
  483.         WhichEvent = Pointer - N1
  484.     END IF
  485.         Subnum = SubnumSave
  486.     EXIT SUB
  487. GetError:
  488.     IF ERR = 52 THEN
  489.         ErrorSwitch = Yes
  490.         RESUME GetResume
  491.       ELSE
  492.         ERROR ERR
  493.     END IF
  494.     END SUB
  495.     '=========================================================================
  496.     SUB PlayStuff (PlayString$)  STATIC
  497.     '=========================================================================
  498.     DEFINT A-Z
  499.         SubnumSave = Subnum
  500.         Subnum = 109
  501.     MFore$ = "mf"
  502.     MBack$ = "mb"
  503.     ActualPlayString$ = PlayString$
  504.     IF MemoryResident THEN             ' No Background Music if Resident
  505.         DO
  506.             MBPos = InString(LCASE$(ActualPlayString$), MBAck$)
  507.             IF MBPos THEN 
  508.                 CALL Myd2(ActualPlayString$, MBPos, N2, MFore$)
  509.             END IF
  510.         LOOP WHILE MBPos
  511.     END IF
  512.     ON LOCAL ERROR GOTO PlayError
  513.     PLAY "X" + VARPTR$(ActualPlayString$)
  514. PlayResume:
  515.     ON LOCAL ERROR GOTO 0
  516.         Subnum = SubnumSave
  517.     EXIT SUB
  518. PlayError:
  519.     ErrorSwitch = Yes
  520.     RESUME PlayResume
  521.     END SUB
  522.     '=========================================================================
  523.     SUB ReadCalautoGet  STATIC
  524.     '=========================================================================
  525.     DEFINT A-Z
  526.         SubnumSave = Subnum
  527.         Subnum = 126
  528.     ON LOCAL ERROR GOTO AutoInputError2
  529.     INPUT #FilenumAuto, ApptFilename$, ApptPassword$, AutoMode$, ForceDate
  530. AutoResume2:
  531.     ON LOCAL ERROR GOTO 0
  532.         Subnum = SubnumSave
  533.     EXIT SUB
  534. AutoInputError2:
  535.     IF ERR <> 62 THEN 
  536.         ERROR ERR
  537.       ELSE
  538.         ' Input Record Too Short
  539.         ErrorSwitch = Yes
  540.         RESUME AutoResume2
  541.     END IF
  542.     END SUB
  543.     '=========================================================================
  544.     SUB ReadCalDOSGet  STATIC
  545.     '=========================================================================
  546.     DEFINT A-Z
  547.         SubnumSave = Subnum
  548.         Subnum = 127
  549.     ON LOCAL ERROR GOTO DOSError2
  550.     INPUT #FilenumDOS, DOSCommand$
  551. DOSResume2:
  552.     ON LOCAL ERROR GOTO 0
  553.         Subnum = SubnumSave
  554.     EXIT SUB
  555. DOSError2:
  556.     IF ERR <> 62 THEN
  557.         ERROR ERR
  558.       ELSE
  559.         ' Input Record Too Short
  560.         ErrorSwitch = Yes
  561.         RESUME DOSResume2
  562.     END IF
  563.     END SUB
  564.     '=========================================================================
  565.     SUB ReadCalexclGet  STATIC
  566.     '=========================================================================
  567.     DEFINT A-Z
  568.         SubnumSave = Subnum
  569.         Subnum = 128
  570.     ON LOCAL ERROR GOTO ExclError2
  571.     FOR J = N1 TO N2
  572.         INPUT #FilenumExcl, ExcludefromHistory$(J)
  573.     NEXT
  574. ExclResume2:
  575.     ON LOCAL ERROR GOTO 0
  576.         Subnum = SubnumSave
  577.     EXIT SUB
  578. ExclError2:
  579.     IF ERR <> 62 THEN
  580.         ERROR ERR
  581.       ELSE
  582.         ' Input Too Short
  583.         ErrorSwitch = Yes 
  584.         RESUME ExclResume2
  585.     END IF
  586.     END SUB
  587.     '=========================================================================
  588.     SUB ReadCalfigGet  STATIC 
  589.     '=========================================================================
  590.     DEFINT A-Z
  591.         SubnumSave = Subnum
  592.         Subnum = 129
  593.     ON LOCAL ERROR GOTO FigError
  594.     '  Read 7 Color Pairs (or whatever an old file has)
  595.     INPUT #FilenumFig, Chf, Chb, Cl1f, Cl1b, Cl2f, Cl2b, _
  596.                 Cl3f, Cl3b, Cl4f, Cl4b, Cl5f, Cl5b, Cl6f, Cl6b
  597. FigResume:
  598.     ON LOCAL ERROR GOTO 0
  599.         Subnum = SubnumSave
  600.     EXIT SUB
  601. FigError:
  602.     IF ERR <> 62 THEN 
  603.         ERROR ERR
  604.       ELSE
  605.         ' Input Too Short
  606.         ErrorSwitch = Yes
  607.         RESUME FigResume
  608.     END IF
  609.     END SUB
  610.     '=========================================================================
  611.     SUB ReadCalinit (EntryPoint)  STATIC
  612.     '=========================================================================
  613.     DEFINT A-Z
  614.     '  Any error in this sub is fatal, so no need for fancy error handling
  615.     ON LOCAL ERROR GOTO InitError
  616.     SELECT CASE EntryPoint
  617.         CASE 1
  618.             OPEN "I", #FilenumInit, "calinit.dat"
  619.             ' Res initialization
  620.             FOR I = N1 TO 4
  621.                 FOR J = N1 TO NumberofHotFKeys
  622.                     INPUT #FilenumInit, FunctionScanCodes(I, J)
  623.                 NEXT J
  624.             NEXT I
  625.             FOR I = N1 TO NumberofHotCKeys
  626.                 INPUT #FilenumInit, HotKeyNames$(I)
  627.             NEXT
  628.             FOR I = N1 TO 20
  629.                 INPUT #FilenumInit, ScreenModes$(I)
  630.             NEXT
  631.         CASE 2
  632.             '
  633.             FOR I = N1 TO 12
  634.                 INPUT #FilenumInit, JulianDays(I)
  635.             NEXT
  636.             '
  637.             FOR I = N1 TO 12
  638.                 INPUT #FilenumInit, MonthLength(I)
  639.             NEXT
  640.             '   
  641.             FOR I = N1 TO 12
  642.                 INPUT #FilenumInit, MonthNames$(I)
  643.             NEXT
  644.             '
  645.             FOR I = N1 TO N7
  646.                 INPUT #FilenumInit, DayNames$(I)
  647.             NEXT
  648.             '   
  649.             FOR I = N1 TO 4
  650.                 INPUT #FilenumInit, DateEditLimits(I)
  651.             NEXT
  652.             '
  653.             FOR I = N1 TO 16
  654.                 INPUT #FilenumInit, Colors$(I)
  655.             NEXT
  656.             '
  657.             FOR I = N1 TO N7
  658.                 INPUT #FilenumInit, ColorPairUses$(I)
  659.             NEXT
  660.             '
  661.             FOR I = N1 TO N2
  662.                 INPUT #FilenumInit, ColorPairTypes$(I)
  663.             NEXT
  664.             '
  665.             FOR I = N1 TO 4
  666.                 INPUT #FilenumInit, SoundLevels$(I)
  667.             NEXT
  668.             ScreenTag$ = SoundLevels$(4)
  669.             '---------------------------------------------------------------
  670.             '  Read Printer Code Arrays
  671.             '  IBM
  672.             FOR I = N1 TO 50
  673.                 INPUT #FilenumInit, IBMCodes(I)
  674.                 IF IBMCodes(I) = -99 THEN EXIT FOR
  675.             NEXT
  676.             '---------------------------------------------------------------
  677.             '  Epson Printer
  678.             FOR I = N1 TO 50
  679.                 INPUT #FilenumInit, EpsonCodes(I)
  680.                 IF EpsonCodes(I) = -99 THEN EXIT FOR
  681.             NEXT
  682.             '---------------------------------------------------------------
  683.             '  HP IIP or III or IIID Laser Printers
  684.             FOR I = N1 TO 50
  685.                 INPUT #FilenumInit, HPIIPCodes(I)
  686.                 IF HPIIPCodes(I) = -99 THEN EXIT FOR
  687.             NEXT
  688.             '---------------------------------------------------------------
  689.             '  IBM 4019E or 4019-01 Laser Printers
  690.             FOR I = N1 TO 50
  691.                 INPUT #FilenumInit, I4019Codes(I)
  692.                 IF I4019Codes(I) = -99 THEN EXIT FOR
  693.             NEXT
  694.             '===============================================================
  695.             '   Initialize The Clock Display (Herb's Graphics Modified)
  696.             '===============================================================
  697.             FOR I = N1 TO N3
  698.                 INPUT #FilenumInit, ClockGraphics(I)
  699.             NEXT
  700.             '===============================================================
  701.             FOR I = N1 TO 8
  702.                 FOR J = N1 TO 4
  703.                     INPUT #FilenumInit, EditInstructions(I, J)
  704.                 NEXT J
  705.             NEXT I
  706.             '===============================================================
  707.             FOR I = N1 TO 4
  708.                 INPUT #FilenumInit, EventInput(I)
  709.             NEXT
  710.             '===============================================================
  711.             FOR I = N1 TO 4
  712.                 INPUT #FilenumInit, NoteInput(I)
  713.             NEXT
  714.             '===============================================================
  715.             FOR I = N1 TO N3
  716.                 INPUT #FilenumInit, EventInstructions1(I)
  717.             NEXT
  718.             FOR I = N1 TO N3
  719.                 INPUT #FilenumInit, EventInstructions2(I)
  720.             NEXT
  721.             INPUT #FilenumInit, EventInstructions3
  722.             FOR I = N1 TO 4
  723.                 INPUT #FilenumInit, NoteInstructions1(I)
  724.             NEXT
  725.             FOR I = N1 TO N3
  726.                 INPUT #FilenumInit, NoteInstructions2(I)
  727.             NEXT
  728.             INPUT #FilenumInit, NoteInstructions3
  729.             FOR I = N1 TO N3
  730.                 INPUT #FilenumInit, EventNoteSharedIns(I)
  731.             NEXT
  732.             '===============================================================
  733.             CLOSE #FilenumInit
  734.     END SELECT
  735.     ON LOCAL ERROR GOTO 0
  736.     EXIT SUB
  737. InitError:
  738.     CLS
  739.     PRINT
  740.     PRINT " Initialization Data File CALINIT.DAT Is Defective Or Unavailable "
  741.     SYSTEM
  742.     END SUB
  743.     '=========================================================================
  744.     SUB ReadCalmusicGet  STATIC
  745.     '=========================================================================
  746.     DEFINT A-Z
  747.         SubnumSave = Subnum
  748.         Subnum = 130
  749.     ON LOCAL ERROR GOTO MusicError2
  750.     INPUT #FilenumMusic, Alarm$, Chime$, Warning$
  751. MusicResume2:
  752.     ON LOCAL ERROR GOTO 0
  753.         Subnum = SubnumSave
  754.     EXIT SUB
  755. MusicError2:
  756.     IF ERR <> 62 THEN
  757.         ERROR ERR
  758.       ELSE
  759.         ' Input Too Short
  760.         ErrorSwitch = Yes 
  761.         RESUME MusicResume2
  762.     END IF
  763.     END SUB
  764.     '=========================================================================
  765.     SUB ReadCalresGet  STATIC
  766.     '=========================================================================
  767.     DEFINT A-Z
  768.         SubnumSave = Subnum
  769.         Subnum = 131
  770.     ON LOCAL ERROR GOTO ResError
  771.     '  Read Stay-Res Options if File is There
  772.     '  SrInitials$ is no longer used in SRP4, hence a throw-away
  773.     INPUT #FilenumRes, EverResident$, UserPopDateTime$, _
  774.         UseDiskSwap$, UseEMS$, SrSwapPath$, SrInitials$, _
  775.         SrKscanHot, SrKshiftHot, SrAutoPopDown, SrSnowCheck, _
  776.         SrPopupOnlyIfScreenSaved
  777. ResResume:
  778.     ON LOCAL ERROR GOTO 0
  779.         Subnum = SubnumSave
  780.     EXIT SUB
  781. ResError:
  782.     IF ERR <> 62 THEN 
  783.         ERROR ERR
  784.       ELSE
  785.         ' Input Too Short
  786.         ErrorSwitch = Yes
  787.         RESUME ResResume
  788.     END IF
  789.     END SUB
  790.     '=========================================================================
  791.     SUB ReadCalser  STATIC
  792.     '=========================================================================
  793.     DEFINT A-Z
  794.         SubnumSave = Subnum
  795.         Subnum = 141
  796.     IF FileExist("calser.dat") THEN
  797.         Registered = Yes
  798.         OPEN "I", #FilenumSer, "calser.dat"
  799.         ON LOCAL ERROR GOTO SerError
  800.         '  Read Registration Data
  801.         LINE INPUT #FilenumSer, RegiData$
  802.       ELSE
  803.         Registered = No
  804.     END IF
  805. SerResume:
  806.     ON LOCAL ERROR GOTO 0
  807.     CLOSE #FilenumSer
  808.         Subnum = SubnumSave
  809.     EXIT SUB
  810. SerError:
  811.     IF ERR <> 62 THEN 
  812.         ERROR ERR
  813.       ELSE
  814.         ' Input Too Short
  815.         ErrorSwitch = Yes
  816.         RESUME SerResume
  817.     END IF
  818.     END SUB
  819.     '=========================================================================
  820.     SUB SetDateTimeGet (WhichType, DateTimeChange$)  STATIC
  821.     '=========================================================================
  822.     DEFINT A-Z
  823.         SubnumSave = Subnum
  824.         Subnum = 132
  825.     ON LOCAL ERROR GOTO DateTimeError
  826.     IF WhichType = N1 THEN
  827.         DATE$ = DateTimeChange$
  828.       ELSE
  829.         TIME$ = DateTimeChange$
  830.     END IF
  831. DateTimeResume:
  832.     ON LOCAL ERROR GOTO 0
  833.         Subnum = SubnumSave
  834.     EXIT SUB
  835. DateTimeError:
  836.     ErrorSwitch = Yes
  837.     RESUME DateTimeResume
  838.     END SUB
  839.     '========================================================================
  840.     '========================  END OF CAL1.BAS  =============================
  841.     '========================================================================
  842.